00100		SUBROUTINE READIT
00200		COMMON /Q/ BNW(100),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT,
00300		1 LN,ITYP,TPALN(4),JED  /NAMES/NA(100),LETRS(27),JNAM(27)
00400	CC	1 LN,ITYP,TPALN(4),JED   /IFI/IFI
00500	CC 7/74 COLGATE  COMMON/TYP/ IS FOR COLTTY ROUT.
00600		COMMON/VV/LIMIT, V(1) /A/ ROFF(27),NP(27),PCH(27,32),
00700		1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
00800		1 ,P1(27),JFM(4),COPY(30),IFM(80)
00900		1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
01000		DIMENSION IV(1),LIST(78),JNP(80),KNP(15)
01100	C   WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY 
01200	C   40 LIT CHARS + 30 PARAMS PER INST.
01300	C   60 BG TIMES AVAILABLE.  FOR INSTS AND INSERTS AND EDITS.
01400		COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
01500		1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
01600		1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
01700		COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
01800		1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
01900		1 ZZ,CHN,YY 
02000		1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
02100		1  /C/LPAR,IPRN,QX,RETRO,INVRT,ICON,LCNT,
02200		1 PARENS,JZ,BY,MLX,IZ,ALL,JD,LEND,QTS,ITMP,
02300		1 LP,ILIT,NLIT,KTMP,IC,RAX,RD,IA
02400	C  /C/=26
02500		EQUIVALENCE (VX1,VX(1)),(KNP,JNP,INP1,INP(1)),(IPP,ISCA(2))
02600		1 ,(ISS,ISCA(9)),(ITT,ISCA(11))
02700		1 ,(IE,ISCA(5)),(ID,ISCA(3)),(IF,ISCA(6)),(IAA,ISCA(10))
02800		1 ,(VX2,VX(2)),(VX3,VX(3)),(VX4,VX(4)),(IDOT,IDAT(11))
02900		1 ,(V,IV),(LIST,IFM(3)),(IG,ISCA(8))
03000		DATA TINST /25H(' TYPE INST NAME, ETC'/)/,KSLA/'/'/
03100		1,TEDIT/20H(' RETYPE LINE?'/  )/,IEN/'N'/,ITMPO/'TEMPO'/
03200	C   *************** READS INPUT  ***********************
03300		KIMIT=LIMIT-100
03400	C  FOR WARNING ABOUT BUFFER OVERLOAD (LABEL 1774)
03500		ICHD=0
03600	2308	IF(ITYP)GO TO 2127
03700	23081	TYPE TINST
03800		ACCEPT 77732,JNP
03900		IF(JNP(1).EQ.'	')GO TO 23081
04000	CHECK FOR TAB
04100	77732	FORMAT(80A1)
04200	CC	IF(JED)WRITE(21,77732)INP
04300		IF(JED)CALL COLTTY(JNP,21)
04400		JFM(4)='80A1)'
04500	C  PUTS ON LPT AND TTY
04600		GO TO 1074
04700	CC 6/74 COLGATE2127	JREAD=1
04800	CC 6/74 COLGATE 4400	READ(1,77732,END=2337)JNP
04900	2127	IF(READER(JNP))CALL RUNIT
05000	C  READS A LINE.  IF END OF FILE, JUMPS.
05100	CC  SEE END OF PG.6	IF(SOS)WRITE(JOUT,87732)INP
05200	CC 7/74	IF(SOS)CALL COLTTY(JNP,JOUT,3)
05300	CC 6/74  COLGATE 	GO TO(441,442,443,444,445,446)JREAD
05400	
05500	441	JFM(4)='80A1)'
05600	CC	IF(IFI.GE.0)GO TO 1074
05700		IF(LN.EQ.0)GO TO 1074
05800		REREAD 2114,LN,JNP
05900	C****  READS FILES WITH OR WITHOUT LINE NUMBERS!
06000	CC	IF(JNP(1).EQ.'	')GO TO 2308
06100	CHECK FOR TAB ***** DOESN'T DO WITH SOS FILES ******
06200		JFM(1)=' (I,A'
06300		CALL FMT(JFM,JNP,MLX)
06400		REREAD JFM,LN,J,JNP
06500		GO TO 4127
06600	1074	IF(INP1.EQ.IBLA.OR.INP1.EQ.32347529280)GO TO 2308
06700	C  ABOVE FOR COMMENTS DOESN'T CATCH THIS WITH SOS FILES⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗⊗
06800	C  BIG NUM = '<'
06900		IF(INP1.EQ.'	')GO TO 2308
07000	CHECK FOR TAB
07100		JFM(1)='   (A'
07200		CALL FMT(JFM,JNP,MLX)
07300		REREAD JFM,J,JNP
07400	4127	IF(JED)GO TO 41271
07500		IF(K.EQ.'Y')GO TO 41271
07600	C  K CHECK IS TO PASS AFTER RETYPING
07700		TYPE TEDIT
07800		ACCEPT 77732,K
07900		IF(K.EQ.'Y')GO TO 23081
08000		IF(K.EQ.IG)JED=-1
08100	
08200	
08300	41271	IF(J.EQ.IBLA)GO TO 2308
08400	CHECKS FOR SPACE(IBLA)
08500		LLETRS=MLX
08600	C  LETRS FOR NAME CHANGE FEATURE AT 104
08700		MLX=1
08800		IZ=0
08900		JA=-1
09000		ISUB=4
09100		CALL CLEAN(INP,LEND)
09200	C  CLEANS OUT = AND , AND FINDS LINE LENGTH.
09300		ALL=1.
09400		VX1=0
09500		VX2=0
09600		VX3=0
09700		LK=-1
09800		K=0
09900		OFFSET=0
10000	C** OFFSET IS FOR 'CONTINUATION PARAMETERS' - SO INPUT P'S MATCH INST.
10100	C** CAUTION!!!  ANY 'OFFSET' PARAMS THAT ARE REFERRED TO AFTER AN 'END'
10200	C** MUST USE THE PROPER INTERNAL NUMB. OF SCORE, NOT THE INST. PARAM!!!!!
10300		IF(V(I-1).NE.-9900.-BY)GO TO 364
10400		BY=-1.
10500		I=I-1
10600	364	DO 361 JD=1,LEND
10700		N=INP(JD)
10800		IF(N.NE.'R')GO TO 361
10900	C  LOOKS FOR 'RESTART'
11000		DO 3611 M=JD,LEND
11100		KL=INP(M)
11200		IF(KL.EQ.IBLA)GO TO 3631
11300		IF(KL.EQ.ISEMI)GO TO 3631
11400	CCZZZ IF(KL.EQ.IBLA.OR.KL.EQ.ISEMI.OR.KL.EQ.KSLA.OR.KL.EQ.',')GO TO 3631
11500	3611	INP(M)=IBLA
11600	C   CHANGES 'RESTART' TO BLANKS
11700	3631	DO 363 N=1,NINS
11800		IF(J.NE.INST(N))GO TO 363
11900		IQ(N)=-1
12000	C   SETS RESTART FLAG.  THIS INST WILL NOW APPEAR WITH NEW NUM.
12100		GO TO 362
12200	363	CONTINUE
12300	361	IF(N.EQ.ISEMI)GO TO 6773
12400	6773	K=K+1
12500		IF(K.GT.NINS)GO TO 36
12600		IF(INST(K).NE.J)GO TO 6773
12700		IF(IQ(K).EQ.-1)GO TO 6773
12800	C   FINDS CORRECT INST NUM.  PASSES RESTARTED INSTS.
12900		LK=K
13000		GO TO 1773
13100	36	IF(J.EQ.'RUN;')GO TO 197
13200		IF(J.NE.'RUN')GO TO 97
13300	197	CALL RUNIT
13400	97	IF(J.EQ.'INSER')GO TO 397
13500		IF(J.EQ.'PRECE')GO TO 397
13600		IF(J.NE.'EDIT')GO TO 297
13700	397	ISUB=6  
13800	297	IF(ISUB.GT.4)GO TO 1773
13900		IF(J.EQ.ITMPO)GO TO 1773
14000		IF(J.EQ.'CONDU')GO TO 1773
14100		IF(J.EQ.'PLAY')GO TO 1773
14200		IF(J.EQ.'SECTI')GO TO 1081
14300	C******************  ABOVE AND BELOW FOR 'SECTIONS'
14400		IF(J.EQ.'END')GO TO 1082
14500		IF(J.EQ.'END S')GO TO 1082
14600		IF(J.EQ.'FINIS')GO TO 1082
14700	362	LK=NINS+1
14800		IF(LK.GT.KZY)CALL ERR(LN)
14900		INST(LK)=J
15000		LETRS(LK)=LLETRS
15100	C  SAVE HOW MANY LETTERS IN INST. NAME (FOR 'RUNIT')
15200		IZ=LK
15300		GO TO 1773
15400	
15500	C*********** DOWN TO 8001 FOR 'SECTIONS'
15600	1083	V(I)=-99.
15700		KL=1
15800		GO TO 3083
15900	C  READS 'PLAY SECT. N1,N2'
16000	1081	V(I)=-199.
16100		KL=4
16200	3083	DO 2081 K=KL,72
16300	C******  OR 80 ↑↑↑↑↑↑↑↑↑ ?????
16400		IF(INP(K).EQ.IBLA)GO TO 2081
16500		IV(I+1)=INP(K)
16600		I=I+2
16700	3081	BY=-1.
16800		GO TO 2308
16900	2081	CONTINUE
17000	C   READS SECTION IDENTIFIER, -199. MARKS BEGINNING
17100	C1082	IF(V(I-1).EQ.-9900.-BY)I=I-1
17200	C********* FEB 15,71
17300	1082	V(I)=-299.
17400		I=I+1
17500		GO TO 3081
17600	C   MARKS END OF SECTION
17700	C************************
17800	
17900	8001	FORMAT(A5,5F)
18000	107	FORMAT(I,A5,5F)
18100	4	IF(LK.LE.NINS)GO TO 8773
18200		IF(ALL.GT.0)GO TO 1004
18300		IF(IDALL.GT.0)GO TO 8773
18400		BG(LK)=VX1
18500		IDALL=LK
18600		GO TO 2004
18700	C 'MOVE' CHANGES IN 'ALINS' CAN'T BE RESET IN INDIV. INSTS.
18800	1004	BG(LK)=VX1
18900		IF(LK.EQ.IZ)VX1=0
19000	C   MAY 3,71 **** ALL PARAMS WILL BE SET UP AT TIME 0.
19100	C   CHECK EFFECT ON 'MOVE'!
19200	C ******** APR.23, 1971  FIXES BG TIMES IN 'MOVE'?????!!!!!!!
19300	2004	NINS=LK
19400		IF(VX3.NE.0)VX2=10000.+VX3
19500		IF(VX2.EQ.0)VX2=-1
19600		DUR(LK)=VX2
19700		GO TO 900
19800	C******** ABOVE FOR REST ONLY ENTRIES.  FEB 18,71
19900	8773	IF(VX2.NE.0)VX1=VX1*10000.+VX2
20000	900	IF(VX1.NE.BY)GO TO 497
20100		IF(J.NE.'PLAY')GO TO 5773
20200	C*********** 'PLAY' IS FOR 'SECTIONS'
20300	497	BY=VX1
20400	C  BY=CURRENT BG TIME.
20500		V(I)=-9900.-BY
20600		I=I+1
20700		IF(NWZ.NE.0)CALL BGSORT(BY)
20800	5773	IF(J.EQ.ITMPO)GO TO 1106
20900		IF(J.EQ.'CONDU')GO TO 3018
21000		IF(J.EQ.'PLAY')GO TO 1083
21100	C*********** ABOVE FOR 'SECTIONS'
21200	
21300	
21400	4773	NW=LPAR
21500	CZZZZZZZ	MLX=ML
21600		ML=MLX
21700		IF(I.LT.KIMIT)GO TO 774
21800		TYPE 107,I
21900		IF(I.GE.LIMIT)TYPE 1774
22000	1774	FORMAT(/' ******* TOO MUCH INPUT DATA!!   USE "MIXSCR" *******'/)
22100	774	ALL=1.
22200		DF=0
22300		ISUB=1
22400	CXXX	IF(MLX.LT.LEND)GO TO 17732
22500	CXXX THIS LOST ON );Px . . . ;  TAKEN OUT 8/20/76
22600	CXXX	GO TO 7773
22700	
22800	CZZZZZZZZZZZZZZZZZZZZZZZZ
22900	1299	IF(MLX.LE.LEND)GO TO 1773
23000	CZZZZZZZZZZZZZZZ .LT. ZZZZZZZZZZZZ
23100	
23200	
23300	7773	IF(READER(JNP))CALL RUNIT
23400	C  READS A LINE.  IF END OF FILE, JUMPS.
23500	CQQQ	IF(INP1.EQ.IBLA)GO TO 7773
23600		IF(INP1.EQ.IBLA.OR.INP1.EQ.32347529280)GO TO 7773
23700	C  ABOVE FOR COMMENTS.  BIG NUM = '<'
23800		IF(JED)GO TO 77733
23900		TYPE TEDIT
24000		ACCEPT 77732,K
24100		IF(K.NE.'Y')GO TO 442
24200		TYPE TPALN
24300		ACCEPT 77732,JNP
24400	442	IF(K.EQ.IG)JED=-1
24500	C   DOESN'T WORK FOR EDITS AND INSERTS YET???
24600	
24700	
24800	77733	MLX=1
24900	C  FOR CONTINUATION LINES.(CAN'T 'CONTINUE' TWICE IN A ROW!!)
25000	C   'LISTS' MUST END WITH ; IN NEW(7/74) VERSION. 
25100		CALL CLEAN(INP,LEND)
25200	1773	IF(IPRN.EQ.0)GO TO 17732
25300		L=I-1
25400		IF(QTS.GE.0)GO TO 597
25500		IF(V(I-1).EQ.999.)L=L-1
25600	597	IPRN=IPRN-1
25700		IF(PARENS.EQ.0)GO TO 17733
25800		PARENS=0
25900		LIST(LCNT+2)=L
26000		LCNT=LCNT+3
26100		IF(IPRN.EQ.0)GO TO 17732
26200		IPRN=0
26300	17733	LIST(MOT)=L
26400		MOT=0
26500	C   FOR ERROR TRAP
26600	
26700	CC17732	JZ=0
26800	17732	N=0
26900	17731	ML=MLX
27000	
27100	C   BIG LOOP -- TO END OF PAGE 1.
27200		JD=ML
27300	975	N=INP(JD)
27400		IF(N.EQ.IBLA)GO TO 236
27500	CCZZZ	IF(N.EQ.IBLA.OR.N.EQ.',')GO TO 236
27600	C ((((())))) MAY 13,71 /Z (D4/E/X 2 3)/ CS/ ETC.  CAN USE 26 LABELS.
27700	33611	IF(N.EQ.'(')GO TO 697
27800		IF(N.NE.')')GO TO 2361
27900	697	INP(JD)=IBLA
28000		L=JD-1
28100	5113	IF(INP(L).NE.IBLA)GO TO 2113
28200		L=L-1
28300		GO TO 5113
28400	2113	IF(N.EQ.')')GO TO 3361
28500		IF(PARENS.EQ.0)GO TO 1140
28600		LCNT=LCNT+3
28700		IF(MOT.NE.0)CALL ERR(3)
28800		MOT=LCNT-1
28900	1140	DO 11401 JC=1,LCNT-1,3
29000		IF(INP(L).NE.LIST(JC))GO TO 11401
29100	C  FINDS DUPLICATE IDENTIFIER
29200		TYPE 11402,INP(L)
29300		CALL EXIT
29400	
29500	11402	FORMAT(' MOTIVIC (',A1,') USED TWICE')
29600	11401	CONTINUE
29700		LIST(LCNT)=INP(L)
29800		PARENS=-1.
29900		INP(L)=IBLA
30000		LIST(LCNT+1)=I
30100		GO TO 236
30200	C ''''''' FOR SINGLE QUOTES
30300	3361	IPRN=IPRN+1
30400		GO TO 236
30500	C  JUMPS BACK INTO QUOTE SECTION
30600	CQ	IF(PARENS.EQ.0)GO TO 2140
30700	CQ	LIST(LCNT+2)=L
30800	CQ	LCNT=LCNT+3
30900	CQ	PARENS=0
31000	CQ	GO TO 33612
31100	CQ2140	LIST(MOT)=L
31200	CQ	GO TO 33612
31300	CQC )))))))))))  LAST ) CAN'T APPEAR AT END OF LINE!!
31400	C @@@@@@@@@@@@ /@Z/DS3/ ETC. 
31500	2361	IF(N.NE.':')GO TO 2362
31600		ICHD=ICHD+1
31700		N=KSLA
31800		GO TO 336
31900	2362	IF(N.NE.'@')GO TO 5361
32000		DO 113 L=1,LEND
32100		K=JD+L
32200	C   K IS USED AT 240!!!
32300		JG=INP(K)
32400		IF(JG.NE.'-')GO TO 6113
32500		RETRO=0
32600		INP(K)=IBLA
32700		GO TO 113
32800	6113	IF(JG.NE.'$')GO TO 7113
32900	C  '$' IS FOR INVERSIONS IN 'NOTES'
33000		INVRT=0
33100		GO TO 113
33200	7113	IF(JG.NE.IBLA)GO TO 4113
33300	113	CONTINUE
33400	4113	DO 6361 JMOT=1,LCNT,3
33500		IF(JG.NE.LIST(JMOT))GO TO 6361
33600		VX1=0
33700		DO 40 M=JD+2,LEND
33800		JG=INP(M)
33900		IF(JG.EQ.IBLA)GO TO 40
34000	CCZZZ	IF(JG.EQ.KSLA.OR.JG.EQ.ISEMI.OR.JG.EQ.'*')GO TO 140
34100		IF(JG.EQ.KSLA)GO TO 140
34200		IF(JG.EQ.ISEMI)GO TO 140
34300		ML=M
34400		GO TO 240
34500	40	CONTINUE
34600	240	JC=JA
34700		JA=-1
34800		INP(K)=IBLA
34900		CALL SCANR
35000		JA=JC
35100	140	JC=1
35200		KN=LIST(JMOT+1)
35300		M=LIST(JMOT+2)+1
35400		IF(RETRO)GO TO 640
35500		JC=M-1
35600		M=KN-1
35700		KN=JC
35800		JC=-1
35900		RETRO=-1.
36000	640	IF(INVRT)GO TO 940
36100	840	X=V(KN)
36200		RB=X
36300		X=ABS(X)+VX1
36400		Z=X
36500		IF(RB)Z=-Z
36600		V(I)=Z
36700	CC	V(I)=X+VX1
36800	C  FINDS CENTER FOR INVERSION (+TRANSP.)
36900		I=I+1
37000		KN=KN+JC
37100		IF(V(KN-JC).NE.85.)GO TO 940
37200		V(I-1)=85.
37300		GO TO 840
37400	
37500	940	Z=V(KN)
37600		IF(INVRT.EQ.0)GO TO 440
37700		IF(VX1.EQ.0)GO TO 540
37800	C  " @Q N "  WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
37900		IF(CODE.EQ.-33.)GO TO 440
38000		V(I)=Z*VX1
38100		GO TO 7361
38200	440	IF(Z.EQ.85.)GO TO 540
38300		Y=0
38400		RB=VX1
38500		IF(Z)RB=-RB
38600		IF(INVRT)GO TO 541
38700		RB=-RB
38800		RC=X
38900		IF(Z)RC=-RC
39000	C THIS STUFF FOR CHORD FEATURE
39100		Y=(RC-Z)*2
39200	541	V(I)=Z+RB+Y
39300	CC	IF(INVRT.EQ.0)Y=(X-Z)*2.
39400	CC	V(I)=Z+VX1+Y
39500		GO TO 7361
39600	540	V(I)=Z
39700	7361	IF(JC.GT.0)GO TO 543
39800		IF(CODE.NE.-33)GO TO 543
39900		JG=I
40000		IF(V(I).GT.0)GO TO 543
40100	542	Y=V(JG)
40200		V(JG)=V(JG-1)
40300		V(JG-1)=Y
40400	C THIS STUFF FOR CHORD FEATURE
40500		IF(V(JG-2).GT.0)GO TO 543
40600		JG=JG-1
40700		GO TO 542
40800	543	I=I+1
40900		KN=KN+JC
41000		IF(KN.NE.M)GO TO 940
41100	
41200		INVRT=-1
41300		RB=V(I-1)
41400		DO 8361 L=JD,LEND
41500		JG=INP(L)
41600	C   PUT IN NOV 25, 72
41700	CCZZZ	IF(JG.EQ.ISEMI)GO TO 93612
41800		KN=L
41900		INP(L)=IBLA
42000		IF(JG.EQ.KSLA)GO TO 9361
42100		IF(JG.EQ.')')IPRN=IPRN+1
42200		IF(JG.NE.ISEMI)GO TO 8361
42300		IAMP=-1
42400		GO TO 9361
42500	8361	CONTINUE
42600	C  ABOVE 4 LINES PUT IN 8/76. REPLACE C***********  ↓↓
42700	
42800	9361	MLX=L+1
42900		IF(L.GE.LEND)GO TO 93612
43000	C************9361	MLX=L
43100	C************	IF(L.EQ.LEND)GO TO 93612
43200	C ↑↑↑↑↑↑↑ 6/75
43300	C  FIX THIS & =IBLA BY CHNGING DO LOOP TO 'GO TO' AT 6721,2722
43400		IF(IAMP.NE.0)GO TO 797
43500		IF(QTS)GO TO 1773
43600	C  GO BACK IF NOT END OF LINE
43700	797	JZ=-1
43800	93612	IF(IAMP.EQ.0)GO TO 93611
43900	C   NOV 25, 72
44000		IF(QTS)GO TO 3013
44100		GO TO 2722
44200	C  THESE ARE FOR "LIT" ITEMS
44300	C  *******  DO NOT USE '@-' OR '@$' WITH 'LIT', RLIST OR RNOT****
44400	C  NO $ WITH FUNC.  $ WITH NUMS AND RHY CAN GIVE NEG RESULT -- TRY IT!
44500	CCZZZ93611	IF(JG.EQ.ISEMI)GO TO 7773
44600	93611	IF(KN.EQ.LEND)GO TO 7773
44700		JZ=0
44800		IF(IPRN.NE.0)GO TO 1773
44900	C ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑PICKS UP ' @X)/ ' SITUATION.  22/6/73
45000		GO TO 236
45100	C  LAST TIME FOR QUOTES
45200	
45300	C********↑↑ ↑↑ WAS TO 6017  JUNE 10,71
45400	C   JUMPS TO END STRING OF QUOTES
45500	6361	CONTINUE
45600		CALL ERR(LN)
45700	C @@@@@@@@@@@@@@@@@@@@@@@@@@
45800	5361	IF(N.EQ.'$')CALL ERR(LN)
45900	C  FOUND $  BUT NO @!
46000		IF(N.NE.ID)GO TO 53611
46100		IF(ISUB.NE.1)GO TO 53611
46200		IF(INP(JD+1).NE.IF)GO TO 236
46300	C  JUMP IF NOT DUTY FACTOR
46400		DF=DF-100.
46500		GO TO 43615
46600	53611	IF(N.NE.ISS)GO TO 53612
46700		IF(INP(JD+1).NE.'U')GO TO 53612
46800		DF=DF-200
46900	C  FOR SUBROUTINE FLAG.  CAN'T CALL SUBR AT SAME TIME AS REP OR X!!!!
47000		GO TO 43615
47100	53612	IF(N.NE.IAA)GO TO 43611
47200	C   FINDS 'ALL'.
47300		IF(INP(JD+1).NE.'L')GO TO 236
47400		ALL=-1.
47500		GO TO 43615
47600	C  TYPE 'ALL' AFTER PARAM NUM TO PUT DATA IN ALL INSTS.
47700	
47800	C  QUAD CALL MUST BE IN 1ST OF 5 PARAMS.  QUAD MUST BE FOLLOWED
47900	C   BY SPC, / OR ;.  OTHER CALLS SUCH AS MOVE,NUM ETC. CAN
48000	C   APPEAR BEFORE  / OR ;, BUT "ALL" MUST! APPEAR 
48100	C   BEFORE! QUAD (IF USED).
48200	C  ADD AN "F" TO QUAD FOR FUNCTIONS, AN "X" FOR X,Y COORDS.
48300	C BASIC QUAD PRODUCES CIRCLES. /DEGS/RADIUS/CENT. X/CENT. Y/
48400	C  QUADX -- /X /Y / (5TH PARAM WILL ALWAYS BE WASTED)
48500	43611	IF(N.NE.'Q')GO TO 4361
48600		IF(INP(JD+1).NE.'U')GO TO 4361
48700		QX=-13.
48800		DO 43612 N=JD,LEND
48900		J=INP(N)
49000		IF(J.EQ.IXX)QX=QX-1.
49100		IF(J.EQ.IF)QX=QX-2.
49200		IF(J.EQ.IBLA)GO TO 236
49300		IF(J.EQ.KSLA)GO TO 236
49400	CCZZZ	IF(J.EQ.IBLA.OR.J.EQ.KSLA.OR.J.EQ.ISEMI.OR.J.EQ.',')GO TO 236
49500	43612	INP(N)=IBLA
49600	4361	IF(N.NE.'I')GO TO 43613
49700		IF(ISUB.NE.4)GO TO 43613
49800	C  -1= 'NM INV' MAKES INST NAME, P1 AND P2 INVISIBLE (REPLACES SEG, ETC.)
49900	C  -2= 'NM IE' MAKES 'END' OF PRINTOUT INVIS. ( ;PRINT(P1)--ETC.)
50000	C  -3= BOTH BEGINNING AND END ARE INVIS.
50100	C  THIS IS SO PARAMS MAY BE EXTENDED TO 58 ON TO A DUMMY INST.
50200		L=-1
50300		N=INP(JD+1)
50400		IF(N.EQ.IE)L=L-1
50500		INVIS(LK)=INVIS(LK)+L
50600	43615	DO 43614 L=JD,LEND
50700		N=INP(L)
50800	CC	IF(N.EQ.IBLA.OR.N.EQ.KSLA)GO TO 236
50900		IF(N.EQ.IBLA)GO TO 236
51000		IF(N.EQ.ISEMI)GO TO 236
51100	CCZZZ	IF(N.EQ.IBLA.OR.N.EQ.','.OR.N.EQ.ISEMI.OR.N.EQ.KSLA)GO TO 236
51200	43614	INP(L)=IBLA
51300	CC43613	IF(N.NE.KSLA)GO TO 636
51400	43613	IF(N.NE.KSLA)GO TO 1336
51500	CC	JZ=-1
51600		IF(JD.GE.LEND-1)JZ=0
51700	C  SO IT WILL READ NEXT LINE.
51800	CZZZZZZZZZZZZZZZ	INP(JD)=ISEMI
51900		GO TO 336
52000	CCZZZ436	IF(INP(MLX).NE.IBLA)GO TO 336
52100	CCZZZ	MLX=MLX+1
52200	CCZZZ	GO TO 436
52300	CC636	IF(JD.LT.LEND)GO TO 1336
52400	CC	ICON=0
52500	CC	GO TO 77731
52600	CC	GO TO 7773
52700	C  TO CONTINUE ON NEXT LINE.
52800	CCZZZ636	IF(N.NE.ISEMI)GO TO 936
52900	1336	IF(N.NE.ISEMI)GO TO 936
53000		IAMP=-1
53100	CC	IF(ISUB.NE.1)IAMP=-1
53200	336	MLX=JD+1
53300		IF(ISUB.GE.104)GO TO 104
53400		IF(ISUB.GT.3)GO TO 1899
53500	   	GO TO (101,102,103),ISUB
53600	C             PAR  MOV LIST  OTHERS
53700	CCZZZ936	IF(N.NE.IDOT)GO TO 736
53800	936	IF(N.NE.IDOT)GO TO 136
53900		L=INP(JD+1)
54000		DO 836 KL=1,10
54100	836	IF(L.EQ.IDAT(KL))GO TO 236
54200		IF(CODE.EQ.-22..OR.CODE.EQ.-23.)INP(JD)=1
54300		GO TO 236
54400	C   CHANGES DOTTED RHYTHMS TO '1'S.
54500	CCZZZ736	IF(N.NE.'*')GO TO 136
54600	CCZZZ	IAMP=-1
54700	CCZZZ	INP(JD)=IBLA
54800	CCZZZ	GO TO 336
54900	136	IF(N.NE.IQT)GO TO 236
55000		DO 1361 K=JD+1,LEND
55100		IF(INP(K).NE.IQT)GO TO 1361
55200		JD=K+1
55300		GO TO 975
55400	C   SKIPS MATERIAL IN QUOTES
55500	1361	CONTINUE
55600		CALL ERR(LN)
55700	C   OPEN QUOTES
55800	236	JD=JD+1
55900		IF(JD.LE.LEND)GO TO 975
56000		CALL ERR(1)
56100	1899	CALL SCANR
56200	CZZZZZZZ	ML=MLX
56300	CZZZZZZZZZZZZZZZZZZZZZZZZZZ
56400		GO TO(1,2,3,4,5,6),ISUB
     

00100	101	N=INP(ML)
00200		IZ=ML
00300		ML=ML+1
00400		IF(N.EQ.IBLA)GO TO 101
00500		JA=-1
00600	C AT THIS POINT IT LOOKS FOR P=PARM, E=END, D=DUPL, C=CONTINUATION, R=RUN.
00700		IF(N.EQ.IPP)GO TO 1
00800		IF(N.EQ.IE)GO TO 2308
00900		IF(N.EQ.'R')CALL RUNIT
01000	C   'RUN' MAY REPLACE 'END' FOR LAST INST.
01100		IF(N.EQ.ID)GO TO 7720
01200		IF(N.NE.'C')CALL ERR(LN)
01300	C NEXT FOR 'CONTINUATION'.  AUTOMATICALLY PUSHES UP PARAM NUMS.
01400		OFFSET=OFFSET+1
01500		LPAR=OLDPAR+OFFSET
01600		TYPE 1201,OFFSET
01700	2201	IF(INP(ML).EQ.IBLA)GO TO 3201
01800	C  TO MOVE POINTER AHEAD.  MUST HAVE BLANK AFTER 'C' OR 'CO' OR 'CONT', ETC.
01900		ML=ML+1
02000		GO TO 2201
02100	3201	IZ=ML-1
02200		M=0
02300		GO TO 201
02400	1201	FORMAT(' ****PARAMETER OFFSET=',F2.0)
02500	
02600	1	CALL SCANR
02700		OLDPAR=VX1
02800	C SAVE PARAM NUM. FOR POSSIBLE 'CONTINUATION'.  BEWARE OF >P30!!!!
02900		LPAR=OLDPAR+OFFSET
03000	201	IJ=LPAR
03100		IF(IJ.GT.32)CALL ERR(LN)
03200	CATCHES PARAM. OUT OF RANGE.
03300		IF(QX.GE.0)GO TO 5703
03400		IJ=LPAR+4
03500	C  SETS UP PARAM FOR QUAD CALL
03600		V(I)=IJ+LK*10000
03700		V(I+1)=2*ALL
03800	C  TEST "ALL" FEATURE HERE!!!!!!!
03900	C  X=-13(DEGREES),=-14(X,Y),=-15(CIRCLE FUNCTS),=-16(LINE FUNCTS)
04000		V(I+2)=QX
04100		I=I+3
04200		QX=0.
04300	5703	IAMP=0
04400		IF(IJ.LE.NP(LK))GO TO 897
04500		IF(IJ.LT.31)NP(LK)=IJ
04600	897	IF(LPAR.EQ.32)LPAR=1
04700		V(I)=LPAR+LK*10000
04800	C  +1=WDCNT, +2=CODE, +3='NM' CCCCC
04900		IJ=I+1
05000		I=I+4
05100		ITMP=0
05200		CODE=0
05300		NFLG=1
05400		ML=IZ+M
05500	C   RE=REP  R=RHY  L=LIT  M=MOVE  MX=MOVX  N=NOTES  NU=NUM  
05600	C   S--L=SUBL  S--N=SUBN  T=TAP  RT=RTAP  RL=RLIST  RN=RNOTES
05700	C  QU=QUADC  QUX=QUADX 
05800	5702	ML=ML+1
05900	CC	IF(ML.GT.72)GO TO 99
06000		N=INP(ML)
06100		IF(N.EQ.IBLA)GO TO 5702
06200		IF(N.EQ.',')GO TO 5702
06300		NL=INP(ML+1)
06400		JA=-1
06500		ISUB=0
06600		IF(N.EQ.IXX)GO TO 2703
06700		IF(N.EQ.'R')GO TO 6702
06800		IF(N.EQ.IF)GO TO 8702
06900		IF(N.EQ.IPP)GO TO 7006
07000		IF(N.NE.'C')GO TO 4005
07100		IF(NL.EQ.'U')GO TO 7006
07200	C  FOR 'CUTOFF'
07300	4005	JA=0
07400		IF(N.EQ.IEN)GO TO 6005
07500		IF(N.EQ.'M')GO TO 703
07600		IF(N.EQ.'L')GO TO 2720
07700		IF(N.EQ.ISS)GO TO 6703
07800		IF(N.EQ.ITT)GO TO 4018
07900		IF(N.EQ.IQT)GO TO 5720
08000		IF(N.EQ.ISEMI)GO TO 2018
08100	C 7/75	IF(N.EQ.IPP)JA=-1
08200	C  FOR ;P5  P3;
08300	7006	CALL SCANR
08400		IF(ISUB.EQ.8)GO TO 8
08500		I=I+JJ
08600		V(IJ+1)=NNUM+DF
08700		IF(JJ.EQ.1)GO TO 4006
08800	C  IF NNUM IS '-2' THEN NOTES ARE PRINTED
08900		IF(NNUM.NE.-2)GO TO 5006
09000		IX=IJ+3
09100		DO 2006 K=2,JJ,3
09200	2006  CALL RANR(VX,K)
09300	C   FOR RAN. SELEC. OF NOTES.  FINDS HIGHEST NOTE.
09400	5006	IX=IJ+2
09500		DO 6006 K=1,JJ
09600	6006	V(IX+K)=VX(K)
09700		IF(NL.EQ.'U')GO TO 8006
09800		V(IX+JJ-2)=1.
09900	C  ABOVE ENSURES THAT LAST RAND. UNIT REACHES 100% - 5/74 *********
10000		GO TO 3013
10100	4006	IF(JA)VX1=-VX1/100.-9999.
10200	C  CHANGES ;P5 P3; TO ;P5 -9999.03; ***** CHECK OUT ON OTHER MACHINES!
10300	CIRC4006	IF(JA)VX1=VX1/100.+9999.
10400	CIRC  CHANGES ;P5 P3; TO ;P5 9999.03; ***** CHECK OUT ON OTHER MACHINES!
10500		V(I-1)=VX1
10600		GO TO 3013
10700	8006	V(IJ+1)=-19
10800	C  FOR 'CUTOFF N1, N2' -- TO END RAND TIMES TOGETHER.
10900		GO TO 3013
11000	6702	IF(NL.EQ.IE)GO TO 2703
11100	C   JUMP IF "REP"
11200		IF(NL.EQ.ITT)GO TO 4018
11300	C   JUMP IF "RTAP"
11400		CODE=-22
11500		IF(NL.EQ.'L')CODE=-46.0
11600	C   JUMP IF "RLIST" (LIST OF RAND SELECTIONS)
11700		IF(NL.NE.IEN)GO TO 1016
11800	C   JUMP IF NOT "RNOTES"
11900		JA=0
12000	C   FOR SCANR
12100		CODE=-36.
12200		GO TO 1016
12300	6005	CODE=-33
12400		IF(NL.EQ.'A')GO TO 2721
12500	C  NUMS, NOTES, NAMES.
12600		IF(NL.NE.'U')GO TO 1016
12700		CODE=-44.
12800	1610	JA=-1
12900		GO TO 1016
13000	8702	CODE=-35
13100		IF(NL.EQ.'U')GO TO 1016
13200		ML=ML+1
13300		CALL SCANR
13400	7	V(IJ+1)=CODE+DF
13500		V(IJ+2)=1.
13600		IF(VX1.GT.15)CALL ERR(4) 
13700	C TRAPS F NUMS >15.
13800		V(I)=VX1+85.
13900		GO TO 7703
14000	C********  MOVE IS NEXT ***********
14100	703	BW=V(IJ-2)
14200		IC=0
14300	CC	DO 7031 K=ML+1,72
14400		DO 7031 K=ML+1,LEND
14500		LP=INP(K)
14600		IF(LP.EQ.KSLA)GO TO 8031
14700	CC	IF(INP(K).EQ.ISEMI)GO TO 8031
14800		IF(LP.EQ.IPP)IC=1
14900	C 'MOVP' P7 MOVP/10 3,4.9 5,5.9;MOVES FROM RAN SEL. OF P3,P4 TO P5,P5.
15000	7031	IF(LP.EQ.IXX)IC=-1
15100	C   IC=-1 IS FOR MOVX, IC=0 FOR MOVE, IC=1 FOR MOVP.
15200	8031	I=I-1
15300		V(I)=0
15400		X=-9900.-BY
15500		IF(BY.EQ.0)X=-9900.-BG(LK)
15600	   	IF(BW.EQ.X)GO TO 8005
15700		IF(BW.NE.-9900.-BY)GO TO 1102
15800		V(IJ-2)=X
15900		GO TO 8005
16000	1102	V(IJ)=V(IJ-1)
16100		V(IJ-1)=X
16200		IJ=IJ+1
16300		I=I+1
16400	8005	LP=IJ-1
16500		BW=-9900.-X
16600		ISUB=2
16700		IZ=-1
16800	C  ABOVE ARRANGES NECESSARY BG TIME HEADINGS.
16900	4703	GO TO 1299
17000	102	IF(IZ.LT.0)GO TO 2102
17100	C  SKIPS NEXT FIRST TIME
17200		BW=V(ICT)+BW
17300		V(I)=-9900.-BW
17400		V(I+1)=V(LP)
17500		V(I+2)=(JJ+2)*ALL
17600		V(I+3)=CODE+DF
17700		I=I+4
17800		IZ=1
17900	2102	IF(BW.LT.10000.)CALL BGSORT(BW)
18000	C   ROUND-OFF NONSENSE
18100	2	VX3=-9900.
18200		VX2=VX3 
18300		CALL SCANR
18400		IF(JJ.GT.0)GO TO 5102
18500		JJ=ILIT
18600	C SLASH WILL REPEAT MOVE INPUT -- 6/74
18700		DO 6102 K=1,JJ
18800	6102	VX(K)=VX(K+20)
18900		GO TO 5005
19000	C::::::::::::::: PUT THIS, AND AT 5505, IN SCOR5 ALSO ::::::::::::::
19100	5102	IF(JJ.EQ.4)CALL ERR(LN)
19200	C  ERROR -- 4 ITEMS IN MOVE IMPOSSIBLE
19300		IF(VX3.NE.-9900.)GO TO 3102
19400		IF(VX2.NE.-9900.)GO TO 4102
19500		VX2=VX1
19600		VX1=10000.
19700	4102	VX3=VX2
19800		JJ=3
19900	C  1,2 OR 3 NUMS CAN BE USED IN NON-RAN MOVES.
20000	3102	IF(IZ.GE.0)GO TO 3006
20100		V(IJ)=(JJ+2)*ALL
20200	C  WORD COUNT
20300		CODE=-55.
20400		IF(JJ.NE.3)CODE=-57.
20500		IF(NFLG)CODE=CODE-1.
20600		IF(IC)CODE=-59.
20700	C  CODE=-56 OR -58 FOR NOTES.
20800		V(IJ+1)=CODE+DF
20900		IZ=0
21000	3006	IF(NFLG.EQ.1)GO TO 5005
21100		CALL RANR(VX,2)
21200	      IF(JJ.NE.3)CALL RANR(VX,4)
21300	C   FOR RAN. SELEC. OF NOTES.  FINDS HIGHEST NOTE.
21400	5005	IF(IC.LE.0)GO TO 3003
21500	C NEXT FOR 'MOVP',  MOVE FROM PARAM TO PARAM.
21600		DO 1003 K=2,JJ
21700	1003	VX(K)=-VX(K)/100.0-9999.0
21800	CIRC1003	VX(K)=VX(K)/100.0+9999.0
21900	C  CHANGES PARAM NUMS TO MAGIC NUMS.
22000	3003	ICT=I
22100		ILIT=JJ
22200	C  SAVES FOR SLASH REPEAT FEATURE
22300	  	IJ=IJ+1
22400		DO 1006 K=1,JJ
22500		VX(20+K)=VX(K)
22600	C  SAVES FOR SLASH REPEAT FEATURE
22700	1006	V(IJ+K)=VX(K)
22800		I=I+JJ  
22900		IJ=I+2
23000		IF(IAMP.EQ.0)GO TO 1299
23100	C*************** MAY 18,71 ***** ALWAYS RESETS TO TIME 0 WHEN MOVE IS USED.
23200		V(I)=-9900.-BY
23300		GO TO 8703
23400	
23500	7703	V(IJ)=4.*ALL
23600	8703	I=I+1
23700		GO TO 4773
23800	C   FOR SUBROUTINES, -12=NUMS.  -11=LETTERS.
23900	6703	CODE=-12.
24000		IF(INP(ML+3).EQ.'L')CODE=-11.
24100		V(IJ)=2.*ALL
24200		V(IJ+1)=CODE+DF
24300		I=I-1
24400		GO TO 4773
24500	4018	CNT(LK)=-9900.-BY
24600		P(LK)=V(I-4)
24700	CC 6/74 COLGATE 	JREAD=3
24800	CC 6/74 COLGATE	GO TO 4400
24900	1444	IF(READER(JNP))CALL RUNIT
25000	C  READS A LINE.  IF END OF FILE, JUMPS.
25100	CC443	IF(IFI)REREAD 107,K,IPT(LK,1)
25200	CC	IF(IFI.GE.0)REREAD 8001,IPT(LK,1)
25300	443	IF(LN.NE.0)REREAD 107,K,IPT(LK,1)
25400		IF(LN.EQ.0)REREAD 8001,IPT(LK,1)
25500	C   NAME OF RHYTHM FILE. (ONLY ONE PER INST.)  READS DATA JUST BEFORE RUN
25600		IF(J.EQ.'CONDU')GO TO 444
25700		IF(NL.NE.ITT)GO TO 2338
25800		CODE=-23.
25900		GO  TO 1016
26000	2338	I=I-4
26100		GO TO 4773
26200	3018	CNT(KZY)=-9900.
26300		LK=KZY
26400	C TO PUT 'CONDUCT' FILE NAME IN LAST SLOT (KZY) AT 443
26500		GO TO 1444
26600	444	P(KZY)=980000.
26700		GO TO 2308
26800	C   CAN'T USE 'TAP' OR 'RTAP' WITH INST KZY IF USING 'CONDUCT'.
26900	C  'REP'
27000	2703	ML=ML+1
27100		VX1=0
27200		VX2=0
27300		VX3=0
27400		IF(N.EQ.IXX)GO TO 2704
27500		INP(ML)=IBLA
27600		INP(ML+1)=IBLA
27700	C  WIPES OUT 'EP' IN 'REP'
27800	2704	CALL SCANR
27900	 	V(IJ)=3.
28000		V(IJ+1)=-66.0
28100		IF(VX1.EQ.32.)VX1=1.
28200		IF(VX1.EQ.0)VX1=LPAR
28300		IF(VX2.EQ.0)VX2=LK-1
28400		V(IJ+2)=VX1+VX2*10000.
28500		KL=VX2
28600		IF(DUR(LK).LT.0)DUR(LK)=DUR(KL)
28700		IF(VX3.EQ.0)GO TO 4773
28800		L=VX3
28900		ML=LK+1
29000		DO 1018 KL=ML,L
29100		IF(LPAR.LE.NP(KL))GO TO 997
29200		IF(LPAR.LT.31)NP(KL)=LPAR
29300	997	IF(DUR(KL))DUR(KL)=DUR(LK)
29400	C  TO SET DUR WHEN DUPLICATING NOTES THAT END WITH 'END;;'
29500		V(I)=V(I-4)+10000.
29600		V(I+1)=3.
29700		V(I+2)=-66.
29800		V(I+3)=V(I-1)
29900	1018	I=I+4
30000		GO TO 4773
30100	
30200	2018	IF(DF.EQ.0)GO TO 20181
30300	C NEXT FOR Pn SUBR/ I.E. NOTHING BUT P AND SUB CALL. 7/73
30400		V(IJ+1)=-201.
30500		V(IJ+2)=1.
30600		V(IJ+3)=0
30700		GO TO 7703
30800	20181	V(IJ)=3.
30900		V(IJ+1)=-66.
31000		V(IJ+2)=NW+LK*10000
31100		GO TO 4773
31200	C  READS /P5  .3 "ABC" .7 "XYZ"/
31300	
31400	8 	V(IJ+1)=-77.+DF
31500	C  DF HAS SUBR CALL INFO
31600		I=I+1
31700		VX(JJ-1)=1
31800	C  FOR RAND. SINGLE LITS.
31900		DO 3722 K=1,JJ,2
32000		V(I)=VX(K)
32100	3722	I=I+1
32200		V(IJ+2)=JJ/2
32300		V(IJ+3)=I
32400		DO 4722 K=2,JJ,2
32500		KN=I
32600		I=I+1
32700		L=VX(K)
32800		DO 6722 KL=L,LEND
32900		IF(INP(KL).EQ.IQT)GO TO 4722
33000		IV(I)=INP(KL)
33100	6722	I=I+1
33200	4722	V(KN)=I-KN-1
33300		V(IJ)=(I-IJ)*ALL
33400		GO TO 4773
33500	2720	QTS=0
33600	2721	ISUB=104
33700		IF(NL.EQ.'A')ISUB=ISUB+1
33800		GO TO 1299
33900	
34000	104	IF(ISUB.EQ.104)GO TO 1041
34100	C NEXT FOR INST NAME CHANGES.  Pn NAMES/N;
34200	C  V LIST= n000n/WDCNT/-89/NUM OF DUPLS/INST NAME/NUM OF LETTERS IN NAME/
34300	C  *********** NO 'ALL' OR 'DUPL' FEATURES WITH NAMES **************
34400		V(IJ)=5
34500		V(IJ+1)=-89
34600		CALL SCANR
34700		V(I-1)=VX1
34800		IV(I)=INST(LK)
34900	CXX	IV(I+1)=2**(1+(7-LETRS)*7)
35000		I=I+2
35100		GO TO 4773
35200	1041	KL=0
35300		DO 6721 K=ML,LEND
35400		L=INP(K)
35500		IF(L.EQ.IBLA)GO TO 6721
35600		JC=K+1
35700		IF(L.EQ.IQT)GO TO 7721
35800		IF(L.EQ.KSLA)GO TO 7232
35900		IF(L.EQ.ISEMI)GO TO 7232
36000		IF(L.NE.IF)GO TO 1040
36100		IF(INP(K+1).NE.'I')GO TO 1040
36200		IF(INP(K+2).NE.IEN)GO TO 1040
36300		IF(INP(K+3).NE.IE)GO TO 1040
36400	C FINDS THE WORD "FINE".
36500		V(I)=-10000.
36600		IF(DUR(LK))DUR(LK)=10000
36700		GO TO 1042
36800	1040	IF(L.EQ.'%')INP(K)=KSLA
36900		IF(L.EQ.'?')INP(K)=ISEMI
37000		IF(L.EQ.'!')INP(K)=','
37100		IF(L.EQ.'#')INP(K)='<'
37200		IF(L.EQ.'&')INP(K)='"'
37300	C  THE ABOVE ARE ALL SPECIAL CHAR'S TO AVOID VARIOUS CONFUSIONS.
37400		IF(KL.EQ.0)KL=K
37500	6721	CONTINUE
37600	C  FOR REPEAT OF ITEM BY SLASH
37700	C  KL IS START OF QUOTE, THEN K IS END -- WHEN NO "S ARE USED.
37800	7232	IF(KL.EQ.0)GO TO 7233
37900		JC=KL
38000		ML=K+1
38100		JD=K-1
38200		NLIT=K-KL
38300		GO TO 8721
38400	
38500	7233	DO 7230 KL=ILIT,ILIT+NLIT
38600		V(I)=V(KL)
38700	7230	I=I+1
38800		GO TO 27222
38900	7231	CONTINUE
39000	
39100	5720	IAMP=-1
39200		JC=ML+1
39300	C  FOR SINGLE 'LIT' ITEMS.
39400	7721	DO 1722 KL=JC+1,LEND
39500		IF(INP(KL).NE.IQT)GO TO 1722
39600		JD=KL-1
39700		ML=KL+1
39800		NLIT=KL-JC
39900	C   EXTENT OF LIT ITEM IS FOUND
40000		GO TO 8721
40100	1722	CONTINUE
40200	C  CAN'T USE SLASH FOR REPEAT AFTER @Q
40300	8721	V(I)=NLIT
40400		ILIT=I
40500		DO 9721 K=JC,JD
40600	C   PUTS ITEM IN "IV" ARRAY
40700		I=I+1
40800	9721	IV(I)=INP(K)
40900		I=I+1
41000	27222	IF(IAMP.EQ.0)GO TO 1299
41100	2722	V(I)=999.
41200	1042	QTS=-1.
41300		X=-88.
41400	CNEW	IF(ISUB.EQ.105)X=-89.
41500	C 105, -89. FOR LIST OF NAMES FOR INST. NAME CHNGS.
41600	27221	V(IJ+1)=X+DF
41700		V(IJ)=(I-IJ+1)*ALL
41800		IJ=IJ+2
41900		V(IJ)=IJ+1
42000		I=I+1
42100		ISUB=1
42200		GO TO 1299
42300	
42400	7720	V(I)=LK
42500		V(I+1)=3.
42600		V(I+2)=-67.
42700		ML=ML+4
42800		CALL SCANR
42900	 	V(I+3)=VX1
43000		I=I+4
43100		L=VX1
43200		IF(NP(LK).LT.NP(L))NP(LK)=NP(L)
43300		IF(DUR(LK).LT.0)DUR(LK)=DUR(L)
43400		GO TO 4773
43500	C   TYPE 'DUPL N;'   N=INST # TO BE DUPLICATED.
43600	142	FORMAT(I,15A5) 
43700	1301	FORMAT(15A5) 
43800	1302	FORMAT(1X15A5) 
43900	CCC2773	FORMAT(I,A5,72A1) 
44000	2114  FORMAT(I,80A1)
44100	300	FORMAT(I,3F,A1)
44200	301	FORMAT(3F,A1)
44300	6	IF(J.NE.'PRECE')GO TO 1341
44400	C  'PRECEDE' WRITES LINES DIRECTLY ON DSK, BEFORE THE WORD 'PLAY;'.
44500	C  NO LIMIT TO THE NUMBER OF LINES.  LAST LINE (NOT PRINTED) MUST 
44600	C  BEGIN WITH *.     KNP ARRAY (15) IS EQUIV. TO INP .
44700	4341	IF(ITYP)GO TO 5341
44800		TYPE TPALN
44900		ACCEPT 1301,KNP
45000		CALL SHORT(KNP,K)
45100		WRITE(21,1301)(KNP(JD),JD=1,K)
45200		GO TO 6341
45300	5341	IF(LN.EQ.0)GO TO 2341
45400	CC5341	IF(IFI.GE.0)GO TO 2341
45500		READ(23,142)K,KNP
45600		GO TO 3341
45700	2341	READ(23,1301)KNP
45800	3341	CALL SHORT(KNP,K)
45900	C  DON'T TYPE TRAILING BLANKS
46000	 	IF(MX.NE.22)TYPE 1302,(KNP(JD),JD=1,K)
46100	6341	IF(MX.EQ.22)WRITE(JOUT,1302)(KNP(JD),JD=1,K)
46200		IF(INP1.EQ.'*')GO TO 2308
46300		IF(MX)WRITE(1,1301)(KNP(JD),JD=1,K)
46400	CC	IF(MX)WRITE(23,1301)KNP
46500		GO TO 4341
46600	1341	KB=KB+1
46700		IF(JED.GT.0)JED=0
46800		IF(J.EQ.'INSER')GO TO 1340
46900		OTH(KB,1)=VX1*100000.+VX2*100.+VX3   
47000		GO TO 340   
47100	1340	X=VX1
47200		IF(VX2.NE.0)X=1000000.+VX1*100000.+VX2    
47300		OTH(KB,1)=X
47400		GO TO 1338
47500	C   ABOVE IS TO PUT INSERT AFTER NOTE # OF A PARTICULAR
47600	C   INSTRUMENT.  FOR COMMENT AT START, SET BG TIME TO 1,1 
47700	C   - BEGIN LINE WITH  <,END WITH ; 
47800	C   UP TO 75 CHARACTERS MAY BE TYPED.     
47900	340      IF(VX3.NE.2)GO TO 1338 
48000		IF(ITYP.GE.0)GO TO 449
48100	CC	JREAD=5
48200	CC 6/74  COLGATE	GO TO 4400
48300		IF(READER(JNP))CALL RUNIT
48400	C  READS A LINE.  IF END OF FILE, JUMPS.
48500	445	OTH(KB,3)=1.
48600	CC	IF(IFI.GE.0)GO TO 447
48700		IF(LN.EQ.0)GO TO 447
48800		REREAD 300,K,OTH(KB,2)
48900		GO TO 1447
49000	447	REREAD 301,OTH(KB,2)
49100	CIRC447	REREAD 301,OTH(KB,2)
49200	1447	IF(JED)GO TO 2308
49300	3445	TYPE TEDIT
49400		ACCEPT 77732,K
49500		IF(K.EQ.IG)JED=-1
49600		IF(J.EQ.'INSER')GO TO 3446
49700		IF(K.NE.'Y')GO TO 2308
49800		IF(JED)GO TO 2308
49900	449	TYPE TPALN
50000		ACCEPT 301,OTH(KB,2)
50100		IF(JED)WRITE(21,301) OTH(KB,2)
50200		GO TO 2308
50300	
50400	1338	IF(ITYP.GE.0)GO TO 1449
50500	CC	JREAD=6
50600	CC 6/74 COLGATE	GO TO 4400
50700		IF(READER(JNP))CALL RUNIT
50800	C  READS A LINE.  IF END OF FILE, JUMPS.
50900	CC446	IF(IFI.GE.0)GO TO 448
51000	446	IF(LN.EQ.0)GO TO 448
51100		REREAD 142,K,(OTH(KB,JD),JD=2,16)    
51200		GO TO 1446
51300	448	REREAD 1301,(OTH(KB,JD),JD=2,16)    
51400	1446	IF(JED)2446,3445,2446
51500	3446	IF(K.NE.'Y')GO TO 2446
51600		IF(JED)GO TO 2446
51700	1449	TYPE TPALN
51800		ACCEPT 1301,(OTH(KB,JD),JD=2,16)
51900		IF(JED)WRITE(21,1301)(OTH(KB,JD),JD=2,16)
52000	2446	X=OTH(KB,2)
52100		IF(J.NE.'INSER')GO TO 971
52200		IF(VX3.EQ.0)GO TO 971
52300		IF(X.NE.'*')GO TO 6
52400	971	IF(X.EQ.'*')KB=KB-1
52500	C   ALLOWS SEVERAL LINES OF 'INSERT' IF ANY 3RD #.
52600	C   LAST LINE HAS '*' IN COLUMN 1.
52700		GO TO 2308
52800	C   IF NO PARAM NUM IS GIVEN, ALL PARAMS MUST BE TYPED.
52900	C   INSERT MAY INCLUDE 10 CHARS(P3-P30),
53000	C   P2, A # ONLY.  IF MORE THAN 1 PARAM IS TO BE EDITED AND
53100	C   P2 IS ONE OF THEM, FIRST EDIT P2 TO DESIRED VALUE,
53200	C   CHANGE P2 TO MINUS = THEN INSERT ENTIRE NOTE TO PLAY
53300	C   JUST AFTER ORIGINAL NOTE(WHICH WILL BE A REST).
53400	C   BX=INST N. Y=NOTE N. Z=PARAM N. 
     

00100	1106	KTMP=1
00200		TP=60.
00300		IAMP=0
00400		BW=BY
00500		ITMP=-1
00600		ISUB=5
00700		JA=-1
00800		GO TO 2016
00900	3019	V(I)=990000.00
01000		V(I+1)=4.
01100		V(I+2)=VX1
01200		V(I+3)=VX2/TP
01300		V(I+4)=VX3/TP
01400		I=I+5
01500		BY=BW
01600	C  SEPT 18, 70
01700		IF(VX1.EQ.0)GO TO 2308
01800		BW=BW+VX1
01900		V(I)=-9900.-BW
02000		I=I+1
02100		CALL BGSORT(BW)
02200	9003	IF(IAMP)GO TO 4003
02300	2016	VX3=0
02400		VX2=0
02500		GO TO 1299
02600	5	IF(VX2.NE.0)GO TO 105
02700	C  'TEMPO/120;'  OR  'TEMPO/1.5 72;'  IS OK.
02800		VX2=VX1
02900		VX1=0
03000	105	IF(VX3.EQ.0)VX3=VX2
03100		IF(VX2.LT.11.)TP=1.
03200		IF(J.EQ.ITMPO)GO TO 3019
03300	  	PCH(1,KTMP)=VX1
03400		PCH(2,KTMP)=VX2
03500		PCH(3,KTMP)=VX3
03600	C   PCH(1)=TIME  (2)=MM1  (3)=MM2
03700		KTMP=KTMP+1
03800		IF(IAMP.EQ.0)GO TO 2016
03900	4003	VX1=0
04000		IAMP=0
04100		VX2=VX3
04200		IF(J.EQ.ITMPO)GO TO 3019
04300		PCH(1,KTMP)=0
04400		PCH(2,KTMP)=VX2
04500		PCH(3,KTMP)=VX2
04600	C   MM CAN BE FROM 11 UP  TEMPO FACTOR FROM 10 DOWN.  
04700	C   UP TO 30 TEMPO CHANGES MAY BE MADE.   
04800	
04900	1016      IA=I    
05000	      IZ=1  
05100	3100	V(I-2)=CODE+DF
05200	      ISUB=3     
05300	5016	IF(IAMP.GE.0)GO TO 1299
05400	117	IF(IZ-2)3013,9004,9004
05500	103	K=INP(ML)
05600		IF(K.EQ.ITT)GO TO 1106
05700		IF(K.EQ.KSLA)GO TO 1014
05800		IF(K.EQ.ISEMI)GO TO 1014
05900	CZZZZZZZZZZZZ  CC  ZZZZZZZZZZZZ
06000		IF(K.NE.IPP)GO TO 1010
06100		IF(JA.GE.0)GO TO 1899
06200		JA=-2
06300		GO TO 1011
06400	1010	IF(K.NE.IBLA) GO TO 1899
06500	1011	ML=ML+1
06600		GO TO 103
06700	3	IF(VX1.EQ.-99.)GO TO 4022
06800		IF(CODE.EQ.-22.)GO TO 2017
06900	  	IF(CODE.LT.-23)GO TO 17
07000		IF(IZ/2*2.EQ.IZ)GO TO 17
07100	C    CHECKS PAIRS OF NUMBERS FOR 'RTAP'
07200	2017	IF(VX1.EQ.-10000.)GO TO 17
07300	CIRC2017	IF(VX1.EQ.10000.)GO TO 17
07400	      VX1=4./VX1
07500		IF(JJ.NE.1)GO TO 2014
07600		V(I)=VX1
07700		GO TO 114
07800	
07900	1217	IF(VX1.EQ.-10000.)GO TO 114
08000	CIRC1217	IF(VX1.EQ.10000.)GO TO 114
08100	C    FOR "FINE" IN LIST
08200	      V(I+1)=VX2
08300	      IF(CODE.EQ.-36.)CALL RANR(V,I)
08400	2217	I=I+1
08500	C  SETS UP STRING OF RAND SELECTIONS
08600		GO TO 114
08700	3217	V(I)=V(I-2)
08800		V(I+1)=RB
08900	C  FOR SLASH REPTS OF RAND SELEC UNITS. ("REP" CAN'T BE USED!)
09000		GO TO 2217
09100	C******** PUT IN ERROR TRAP FOR "REP" ETC. ******
09200	
09300	2014	DO 9006 L=2,JJ
09400		IF(VX(L).EQ.0)GO TO 17
09500	9006	VX1=4./VX(L)+VX1
09600		JJ=1
09700	17	IF(JA.NE.-2)GO TO 1012
09800		VX1=-9999.0-VX1/100.0
09900		JA=-1
10000	1012	IF(ICHD.EQ.0)GO TO 4014
10100		JJ=1
10200	C  SETS UP NEXT NOTE AS CHORD (THIS ONE BECOMES NEG.)
10300		VX1=-VX1
10400	C  FOR CHORD FEATURE
10500		ICHD=0
10600	4014	V(I)=VX1
10700		IF(CODE.EQ.-46.)GO TO 1217
10800		IF(CODE.EQ.-36.)GO TO 1217
10900		IF(CODE.NE.-35)GO TO 972
11000		IF(VX1.GT.15)CALL ERR(4)
11100	C  FINDS F NUM.>15!
11200	C  JUMP IF STRING OF RAND SELECS.
11300	972	IF(JJ.EQ.1)GO TO 114
11400		L=VX(JJ)-1
11500		X=V(I)
11600		NL=I+1
11700		I=L+I
11800		DO 1017 K=NL,I
11900	1017	V(K)=X
12000	C   ADDS UP TOTAL   OF NOTES IN SEQ.
12100		IZ=IZ+L
12200		GO TO 114
12300	1014	IF(CODE.EQ.-46.)GO TO 3217
12400		IF(CODE.EQ.-36.)GO TO 3217
12500		IF(CODE.NE.-33)GO TO 1103
12600		IF(V(I-2).GE.0)GO TO 1103
12700	C NEXT FOR SLASH REPEAT OF CHORD
12800	CCC	I=I-1
12900		JC=1
13000		JD=1
13100		GO TO 2103
13200	1103	V(I)=RB
13300	C   RB SAVES IT FOR SLASH REPEAT
13400	114      RB=V(I)     
13500	      I=I+1 
13600	      IZ=IZ+1     
13700	      GO TO 5016    
13800	4022	JC=VX2+.3
13900		JD=VX3-.5
14000		IF(JJ.EQ.2)JD=1
14100	C********* MAY 19,71   ----MANY LINES ABOVE.
14200	2103	IZ=IZ+JC*JD 
14300	C   JD=HOW MANY TIMES,  JC=HOW MANY NOTES 
14400		IF(CODE.NE.-33)GO TO 3103
14500	8103	N=0
14600		V(IA-1)=0
14700		DO 4103 K=I-1,1,-1
14800		IF(V(K).GE.0)N=N+1
14900	4103	IF(N.EQ.JC)GO TO 5103
15000	5103	IF(V(K-1).GE.0)GO TO 6103
15100		IF(V(K).EQ.0)GO TO 6103
15200		K=K-1
15300		GO TO 5103
15400	6103	JC=I-K
15500	CC	I=I+1
15600	
15700	3103	DO 1005 K=1,JD    
15800		NL=I+JC-1  
15900		DO 2005 L=I,NL    
16000	2005  V(L)=V(L-JC)
16100	1005      I=I+JC  
16200		RB=V(NL)
16300	C  RB SAVES DATA FOR SLASH REPEAT FEATURE.
16400	      GO TO 5016  
16500	
16600	9004	IF(ITMP.EQ.0)GO TO 3013
16700		IZ=IZ-1
16800	C***** JAN. 1974
16900	      KA=1  
17000	      IC=1  
17100	      K=0   
17200		J=1
17300	      Z=0   
17400	      RC=0  
17500	9007	Y=PCH(3,IC)/TP
17600		X=PCH(2,IC)/TP
17700	      Z=PCH(1,IC) 
17800		CALL SQYY(YY,X,Y,Z)
17900		XT(1)=X
18000	      PR=RA 
18100	C75      RD=1  
18200	C75      RB=0  
18300	      ZZ=Z  
18400	      CALL ACCEL
18500	      IF(K.EQ.IZ)GO TO 3013
18600		IF(RA.NE.-10000.)GO TO 9007     
18700	C********* MAY 13,71  OMITS REPEATED RHY. FEATURE.
18800	3013	X=I-IJ
18900		V(IJ+2)=X-3.
19000		V(IJ)=X*ALL
19100		IF(CODE.NE.-35)GO TO 4773
19200		M=IJ+3
19300	C   SETS NUMBERS FOR FUNCS.
19400		DO 313 K=M,I-1
19500	313	IF(V(K).LT.85.)V(K)=V(K)+85.
19600		GO TO 4773
19700	
19800		END